/* GUI CONVERTED from arpamtb.p (converter v1.76) Wed May 21 06:59:34 2003 */
/* arpamtb.p - AR PAYMENT MAINTENANCE Auto Apply Selection Criteria           */
/* Copyright 1986-2003 QAD Inc., Carpinteria, CA, USA.                        */
/* All rights reserved worldwide.  This is an unpublished work.               */
/* $Revision: 1.32 $                                                          */
/*V8:ConvertMode=Maintenance                                                  */
/* REVISION: 6.0      LAST MODIFIED: 09/17/90   BY: afs *D071*                */
/* REVISION: 6.0      LAST MODIFIED: 02/28/91   BY: afs *D387*                */
/* REVISION: 6.0      LAST MODIFIED: 03/12/91   BY: MLB *D360*                */
/* REVISION: 6.0      LAST MODIFIED: 03/12/90   BY: MLB *D385*                */
/* REVISION: 6.0      LAST MODIFIED: 05/31/91   BY; MLV *D667*                */
/* REVISION: 6.0      LAST MODIFIED: 09/19/91   BY: MLV *D861*                */
/* REVISION: 6.0      LAST MODIFIED: 11/06/91   BY: MLV *D915*                */
/* REVISION: 7.0      LAST MODIFIED: 03/18/92   BY: jjs *F294*                */
/* REVISION: 7.3      LAST MODIFIED: 04/21/93   BY: bcm *GA00*                */
/* REVISION: 7.4      LAST MODIFIED: 07/10/93   BY: pcd *H027*                */
/*                    LAST MODIFIED: 08/06/93   BY: wep *H105*                */
/*                                   09/22/93   BY: bcm *H133*                */
/*                                   07/06/94   BY: bcm *H431*                */
/*                                   08/22/94   BY: qzl *H483*                */
/*                                   11/01/94   BY: bcm *H585*                */
/*                                   12/06/94   BY: rmh *FU11*                */
/*                                   01/31/95   by: srk *H09T*                */
/*                                   06/12/95   by: wjk *H0DY*                */
/*                                   06/22/95   by: wjk *H0F1*                */
/*                                   01/02/96   by: mys *H0HN*                */
/* REVISION: 8.5      LAST MODIFIED: 01/13/96   by: ccc *J053*                */
/* REVISION: 8.5      LAST MODIFIED: 06/14/96   by: jpm *J0TN*                */
/* REVISION: 8.6      LAST MODIFIED: 07/15/96   by: bjl *K001*                */
/*                                   07/21/96   by: *J0VY* Marianna Deleeuw   */
/*                                   11/25/96   by: jzw *K01X*                */
/* REVISION: 8.6      LAST MODIFIED: 08/12/97   by: *J1YX* Irine D'mello      */
/* REVISION: 8.6E     LAST MODIFIED: 02/23/98   BY: *L007* A. Rahane          */
/* REVISION: 8.6E     LAST MODIFIED: 05/20/98   BY: *K1Q4* Alfred Tan         */
/* REVISION: 8.6E     LAST MODIFIED: 06/25/98   BY: *J2PY* Niranjan R.        */
/* REVISION: 8.6E     LAST MODIFIED: 07/09/98   BY: *L01K* Jaydeep Parikh     */
/* REVISION: 8.6E     LAST MODIFIED: 12/03/98   BY: *L0CS* Brenda Milton      */
/* REVISION: 8.6E     LAST MODIFIED: 08/17/99   BY: *L0GY* Hemali Desai       */
/* REVISION: 9.1      LAST MODIFIED: 11/15/99   BY: *K245* Ranjit Jain        */
/* REVISION: 9.1      LAST MODIFIED: 01/12/00   BY: *L0PH* Vihang Talwalkar   */
/* REVISION: 9.1      LAST MODIFIED: 03/24/00   BY: *N08T* Annasaheb Rahane   */
/* REVISION: 9.1      LAST MODIFIED: 08/11/00   BY: *N0KK* jyn                */
/* REVISION: 9.1      LAST MODIFIED: 08/04/00   BY: *N0VV* BalbeerS Rajput    */
/* Old ECO marker removed, but no ECO header exists *H349*                    */
/* Old ECO marker removed, but no ECO header exists *F0PN*                    */
/*  Revision: 1.24      BY: Katie Hilbert     DATE: 04/01/01 ECO: *P002*      */
/*  Revision: 1.25      BY: Alok Thacker      DATE: 06/12/01 ECO: *M18Y*      */
/*  Revision: 1.26      BY: Seema Tyagi       DATE: 07/16/01 ECO: *M1BW*      */
/*  Revision: 1.27      BY: Ed van de Gevel   DATE: 04/17/02 ECO: *N1GR*      */
/*  Revision: 1.28      BY: Hareesh V         DATE: 09/12/02 ECO: *M209*      */
/*  Revision: 1.29      BY: Hareesh V         DATE: 10/08/02 ECO: *N1WL*      */
/*  Revision: 1.30      BY: Seema Tyagi       DATE: 04/14/03 ECO: *P0PX*      */
/*  Revision: 1.31      BY: Seema Tyagi       DATE: 04/28/03 ECO: *N2DQ*      */
/* $Revision: 1.32 $   BY: Orawan S.         DATE: 05/20/03 ECO: *P0RX*      */
/******************************************************************************/
/* All patch markers and commented out code have been removed from the source */
/* code below. For all future modifications to this file, any code which is   */
/* no longer required should be deleted and no in-line patch markers should   */
/* be added.  The ECO marker should only be included in the Revision History. */
/******************************************************************************/

{mfdeclre.i}
{cxcustom.i "ARPAMTB.P"}
/* EXTERNAL LABEL INCLUDE */
{gplabel.i}

{gldydef.i}
{gldynrm.i}

/* THIS PROGRAM WAS RE-WRITTEN TO INCORPORATE A REVISION TO THE AUTO-  */
/* SELECT PROCESS. SOME OF THE LOGIC NOW EXISTS IN CALLED PROGRAM      */
/* ARPAMTE.P WHICH PERFORMS THE PROCESSING OF THE APPLIED AMOUNTS ON   */
/* THE SELECTED DOCUMENTS.                                             */

define shared variable rndmthd        like rnd_rnd_mthd.
define shared variable ar_amt_fmt     as   character.
define shared variable apply2_rndmthd like rnd_rnd_mthd.
define shared variable old_doccurr    like ar_curr.
define shared variable ar_recno       as   recid.
define shared variable jrnl           like glt_ref.
define shared variable autocpl_code   like mfc_logical initial false.
define shared variable batch          like ar_batch.
define shared variable batch_total    like ar_amt      label "Total".
define shared variable bactrl         like ba_ctrl.
define shared variable desc1          like bk_desc.
define shared variable no_open_doc    like mfc_logical initial false.
define shared variable artotal        like ar_amt      label "Check Control".

{&ARPAMTB-P-TAG9}
define variable disc-date         as   date                      no-undo.
define variable arnbr             like ar_nbr format "X(8)"      no-undo.
define variable arnbr1            like ar_nbr format "X(8)"      no-undo.
define variable ardate            like ar_date                   no-undo.
define variable ardate1           like ar_date                   no-undo.
define variable areff             like ar_effdate                no-undo.
define variable areff1            like ar_effdate                no-undo.
define variable ardue             like ar_due_date               no-undo.
define variable ardue1            like ar_due_date               no-undo.
define variable sel_rec           like mfc_logical initial no    no-undo.
define variable ar_work           like mfc_logical initial no    no-undo.
define variable cpl_code          like mfc_logical               no-undo.
define variable ref_nu            like ard_ref                   no-undo.
define variable vat_ndisc         like ar_amt                    no-undo.
define variable unapl_amt         like ar_amt                    no-undo.
define variable open_amt          like ar_amt                    no-undo.
define variable max_apl           like ar_amt                    no-undo.
define variable max_disc          like ard_disc                  no-undo.
define variable auto_apply        like mfc_logical initial no    no-undo.
define variable bank              like bk_code                   no-undo.
define variable amt-to-pay        like ar_amt                    no-undo.
define variable applied-amt       like ar_applied                no-undo.
define variable amt-due           like ar_amt                    no-undo.
define variable amt-disc          like ar_amt                    no-undo.
define variable armstr_found      like mfc_logical initial no    no-undo.
define variable arapplied         like ar_amt                    no-undo.
define variable inv_type          like tx2d_tr_type initial "16" no-undo.
define variable im_sel_done       like mfc_logical               no-undo.
define variable arddisc           like ar_amt                    no-undo.
define variable mc-error-number   like msg_nbr                   no-undo.
define variable is_transparent    like mfc_logical               no-undo.
define variable inv_to_base_rate  like ar_ex_rate                no-undo.
define variable inv_to_base_rate2 like ar_ex_rate2               no-undo.
define variable comb_exch_rate    like ar_ex_rate                no-undo.
define variable comb_exch_rate2   like ar_ex_rate2               no-undo.

define shared frame a.
define shared frame b.

define buffer armstr3 for ar_mstr.
define buffer armstr  for ar_mstr.

/* REPLACED WORKFILE WITH TEMP-TABLE TO IMPROVE PERFORMANCE */

{&ARPAMTB-P-TAG15}
define new shared temp-table arautosel
   field sel_idr     as character format "X(1)"
   field ar_nbr      like ar_nbr
   field ar_check    like ar_check
   field ar_bill     like ar_bill
   field ar_type     like ar_type
   field ar_due_date like ar_due_date
   field ar_curr     like ar_curr
   field balance     like ar_amt
   field applied     like ar_amt
   field discount    like ar_amt
   field maxdisc     like ar_amt
   index ar-date ar_due_date.

{arpafma.i}

/*DEFINE FORM FOR SHARED FRAME B*/
do for armstr:
   {arpafmb.i}
end. /* DO FOR armstr */

/* DEFINE FORM TO DOCUMENT SELECTION CRITERIA */
{&ARPAMTB-P-TAG1}
FORM /*GUI*/ 
   
 RECT-FRAME       AT ROW 1.4 COLUMN 1.25
 RECT-FRAME-LABEL AT ROW 1   COLUMN 3 NO-LABEL
 SKIP(.1)  /*GUI*/
arnbr     colon 20
   arnbr1    colon 45 label {t001.i}
   ardate    colon 20
   ardate1   colon 45 label {t001.i}
   ardue     colon 20
   ardue1    colon 45 label {t001.i}
   sel_rec   colon 45 label "Select All (*)"
    SKIP(.4)  /*GUI*/
with frame im_sel side-labels width 80 attr-space
    NO-BOX THREE-D /*GUI*/.

 DEFINE VARIABLE F-im_sel-title AS CHARACTER.
 F-im_sel-title = (getFrameTitle("INVOICE/MEMO_SELECTION",32)).
 RECT-FRAME-LABEL:SCREEN-VALUE in frame im_sel = F-im_sel-title.
 RECT-FRAME-LABEL:WIDTH-PIXELS in frame im_sel =
  FONT-TABLE:GET-TEXT-WIDTH-PIXELS(
  RECT-FRAME-LABEL:SCREEN-VALUE in frame im_sel + " ", RECT-FRAME-LABEL:FONT).
 RECT-FRAME:HEIGHT-PIXELS in frame im_sel =
  FRAME im_sel:HEIGHT-PIXELS - RECT-FRAME:Y in frame im_sel - 2.
 RECT-FRAME:WIDTH-CHARS IN FRAME im_sel = FRAME im_sel:WIDTH-CHARS - .5. /*GUI*/

{&ARPAMTB-P-TAG2}

/* SET EXTERNAL LABELS */
setFrameLabels(frame im_sel:handle).

/* PERFORM INITIAL READS */
find ar_mstr
   where recid(ar_mstr) = ar_recno
   exclusive-lock no-error.

for first cm_mstr
   fields (cm_addr cm_sort)
   where cm_addr = ar_mstr.ar_bill
   no-lock:
end. /* FOR FIRST cm_mstr */

assign
   /* FOR swarcs.p POPUP */
   global_addr = ar_bill
   /* INITIALIZE FLAG FOR VALID COMPLETION OF MEMO/INVOICE FRAME */
   im_sel_done = false.

/* BEGIN BY DISPLAYING FORM FOR THE ENTRY OF RANGE CRITERIA */
/* FOR DETERMINING THE DOCUMENTS TO PROCESS                 */
selectblock:
do on endkey undo, leave:

   /* INITIALIZE "TO" VARIABLES */
   if arnbr   = hi_char then arnbr   = "".
   if arnbr1  = hi_char then arnbr1  = "".

   /* EDIT SELECTION CRITERIA BLOCK */
   editblock:
   do on error undo, retry:
/*GUI*/ if global-beam-me-up then undo, leave.

      update
         arnbr
         arnbr1
         ardate
         ardate1
         ardue
         ardue1
         {&ARPAMTB-P-TAG3}
         sel_rec
      with frame im_sel.

      /*VALIDATE DATE RANGES*/
      if ardate > ardate1
      then do:
         /* END DATE CANNOT BE BEFORE START DATE */
         {pxmsg.i &MSGNUM=123 &ERRORLEVEL=3}
         next-prompt ardate with frame im_sel.
         undo editblock.
      end. /* IF ardate > ardate1 */

      if ardue > ardue1
      then do:
         /* END DATE CANNOT BE BEFORE START DATE */
         {pxmsg.i &MSGNUM=123 &ERRORLEVEL=3}
         next-prompt ardue with frame im_sel.
         undo editblock.
      end. /* IF ardue > ardue1 */
   end.
/*GUI*/ if global-beam-me-up then undo, leave.
 /* EDITBLOCK */

   /*SET "TO" VARIABLES FOR UPPER RANGE IF LEFT BLANK */
   if arnbr1  = "" then arnbr1  = hi_char.
   if ardate1 = ?  then ardate1 = hi_date.
   if ardue1  = ?  then ardue1  = hi_date.

   /* SET FLAG FOR COMPLETION OF FRAME */
   im_sel_done = true.

end.  /*SELECTBLOCK*/
/* HIDE MEMO/INVOICE FRAME WHETHER COMPLETED OR INTERRUPTED */
hide frame im_sel.

/* IF MEMO/INVOICE FRAME INTERRUPTED THEN STOP HERE */
if not im_sel_done
then do:
   autocpl_code = false.
   leave.
end. /* IF NOT im_sel_done */

if sel_rec = yes
then
   unapl_amt = artotal.
else
   unapl_amt = 0.

/*READ THROUGH SHARED BUFFER ARMSTR3 TO FIND ALL RECORDS MEETING   */
/*THE SELECTED CRITERIA. CREATE A TEMP-TABLE (ARAUTOSEL) FOR THOSE */
/*SELECTED RECORDS. THIS WILL BE USED TO DISPLAY A SCROLLING FRAME */
/*WHICH WILL ALLOW SELECTION/DESELECTION OF THOSE RECORDS          */

workloop:
for each armstr3
   fields (ar_acct ar_amt ar_applied ar_base_amt ar_base_applied ar_batch
           ar_bill ar_cc ar_check ar_contested ar_cr_terms ar_curr ar_date
           ar_dd_curr ar_dd_ex_rate ar_dd_ex_rate2 ar_disc_acct ar_disc_cc
           ar_disc_date ar_disc_sub ar_draft ar_due_date ar_dy_code ar_effdate
           ar_entity ar_ex_rate ar_ex_rate2 ar_nbr ar_open ar_po ar_sales_amt
           ar_sub ar_type)
   where ar_bill = ar_mstr.ar_bill
   and   ar_open
   use-index ar_bill_open no-lock:

   /* CHECK TRANSPARENCY BETWEEN PAYMENT CURR AND */
   /* DOCUMENT (INV/MEMO/DRAFT) CURR              */
   if ar_type <> "D"
   then
      run is_euro_transparent
         (input armstr3.ar_curr,
         input ar_mstr.ar_curr,
         input base_curr,
         input ar_mstr.ar_effdate,
         output is_transparent).

   /* SELECTS ONLY APPLY-TO RECORDS IN SAME CURRENCY AS PAYMENT */
   /* SELECTS ONLY APPROVED DRAFTS                              */
   /* USE NEW FIELDS DEFINED FOR DRAFT DISCOUNT CURR & RATE.    */
   /* FIELD ar_dd_ex_rate, rate2 REPLACES ar_sales_amt,         */
   /* FIELD ar_dd_curr REPLACES ar_slspsn[1].                   */
   if not( ar_type <> "P"
      and (((ar_curr = ar_mstr.ar_curr or is_transparent )
      and ((ar_type <> "D")
      or (ar_type = "D" and ar_dd_ex_rate = 1
      and ar_dd_ex_rate2 = 1 and ar_dd_curr = "" ))) or
      (ar_type = "D" and (ar_dd_ex_rate <> 1 or ar_dd_ex_rate2 <> 1)
      and ar_dd_curr = ar_mstr.ar_curr) )
      and not armstr3.ar_contested
      and (armstr3.ar_nbr >= arnbr and armstr3.ar_nbr <= arnbr1 ))
      or (armstr3.ar_type = "D" and not armstr3.ar_draft)
   then
      next.

   /* CHECK DATE RANGES, JUMP OUT IF RECORD DOESN'T MATCH */
   /* CHECK AR_DATE FOR WITHIN THE RANGE                  */

   if ardate = ?
   then do:
      {&ARPAMTB-P-TAG11}
      if ar_date > ardate1
      then
         next.
   end. /* IF ardate = ? */

   {&ARPAMTB-P-TAG12}
   else if ar_date < ardate
       or  ar_date > ardate1
   then
      next.

   /* CHECK DUE DATE FOR WITHIN THE RANGE */
   if ardue = ?
   then do:
      {&ARPAMTB-P-TAG13}
      if ar_due_date > ardue1
      then
         next.
   end. /* IF ardue = ? */

   {&ARPAMTB-P-TAG14}
   else if ar_due_date < ardue
        or ar_due_date > ardue1
   then
      next.

   /* ALLOW INV/MEMO/DRAFTS OF ONLY ONE CURRENCY PER PAYMENT */

   for first arautosel
      fields (ar_bill ar_nbr ar_check ar_curr ar_type ar_due_date
              applied balance discount maxdisc sel_idr)
      no-lock:
   end. /* FOR FIRST ARAUTOSEL ... */

   if available arautosel
   then
      if arautosel.ar_curr <> armstr3.ar_curr
      then
         next.

   {&ARPAMTB-P-TAG4}
   /* SET FLAG TO INDICATE A TEMP-TABLE RECORD WAS WRITTEN */
   ar_work = true.

   /* CREATE TEMP-TABLE FOR SELECTING RECORDS TO PROCESS */
   create arautosel.
   recno = recid(arautosel).
   assign
      arautosel.ar_nbr = armstr3.ar_nbr
      arautosel.ar_check = armstr3.ar_check
      arautosel.ar_due_date = armstr3.ar_due_date
      arautosel.ar_bill = armstr3.ar_bill
      arautosel.ar_type = armstr3.ar_type
      arautosel.ar_curr = armstr3.ar_curr.

   /* CALCULATE AND APPLY ANY PROMPT PAYMENT DISCOUNT AVAIALBLE */
   max_apl = armstr3.ar_amt - armstr3.ar_applied.

   do for armstr:
      /* OBTAIN SAME AR REC IN ARMSTR BUFFER SO DISCOUNT.i  */
      /* CAN BE USED                                        */
      for first armstr
         fields (ar_acct ar_amt ar_applied ar_base_amt ar_base_applied ar_batch
                 ar_bill ar_cc ar_check ar_contested ar_cr_terms ar_curr
                 ar_date ar_dd_curr ar_dd_ex_rate ar_dd_ex_rate2 ar_disc_acct
                 ar_disc_cc ar_disc_date ar_disc_sub ar_draft ar_due_date
                 ar_dy_code ar_effdate ar_entity ar_ex_rate ar_ex_rate2 ar_nbr
                 ar_open ar_po ar_sales_amt ar_sub ar_type)
         where armstr.ar_nbr = armstr3.ar_nbr
         no-lock:

         if armstr.ar_type = "I"
         then
            inv_type = "16".
         else if armstr.ar_type = "M"
         then
            inv_type = "18".
      end. /* FOR FIRST armstr */

      /* ADDED TO NOT DISCOUNT VAT IF VTC_PMT_DISC = NO */
      vat_ndisc = 0.
      for each tx2d_det
         fields(tx2d_cur_tax_amt tx2d_ref tx2d_tax_code tx2d_tr_type)
         where tx2d_ref = armstr3.ar_nbr
         and   tx2d_tr_type = inv_type
         no-lock:

         for first tx2_mstr
            fields(tx2_pmt_disc tx2_tax_code)
            where tx2_tax_code = tx2d_tax_code
            no-lock:

            if not tx2_pmt_disc
            then
               vat_ndisc = vat_ndisc + tx2d_cur_tax_amt.
         end. /* FOR FIRST tx2_mstr */
      end. /* FOR EACH tx2d_det */

      /* ASSUME NDISC AMT TAKEN FROM APPLIED */
      vat_ndisc = max(vat_ndisc - armstr3.ar_applied,0).
      if max_apl >= 0
      then
         max_apl = max(max_apl - vat_ndisc,0).
      else
         max_apl = min(max_apl - vat_ndisc,0).

      {ardiscal.i max_disc max_apl armstr3.ar_nbr}

      /* CONVERT AMOUNTS IN PMT CURR WHEN PMT AND INV CURRENCIES */
      /* ARE EURO TRANSPARENT.                                   */
      if armstr3.ar_curr <> base_curr
      or ar_mstr.ar_curr <> base_curr
      then do:
         /* GET INV OR MEMO TO BASE EXCH RATE FROM qad_wkfl */
         {argetwfl.i
            ar_mstr.ar_nbr
            inv_to_base_rate
            inv_to_base_rate2}

         if not available qad_wkfl
         then do:
            if armstr3.ar_curr <> ar_mstr.ar_curr
            then do:
               /* GET EXCHANGE RATE FOR INV CURR TO BASE */
               {gprunp.i "mcpl" "p" "mc-get-ex-rate"
                  "(input armstr3.ar_curr,
                    input base_curr,
                    input """",
                    input ar_mstr.ar_effdate,  /* PMT DATE */
                    output inv_to_base_rate,
                    output inv_to_base_rate2,
                    output mc-error-number)"}
               if mc-error-number <> 0
               then do:
                  {pxmsg.i &MSGNUM=mc-error-number &ERRORLEVEL=2}
               end. /* IF mc-error-number <> 0 */
            end. /* IF armstr3.ar_curr <> ar_mstr.ar_curr */
            else
               assign
                  inv_to_base_rate  = ar_mstr.ar_ex_rate
                  inv_to_base_rate2 = ar_mstr.ar_ex_rate2.

            /* UPD INV OR MEMO TO BASE EX RATE IN qad_wkfl */
            {arupdwfl.i
               ar_mstr.ar_nbr
               inv_to_base_rate
               inv_to_base_rate2}

         end. /* IF NOT AVAILABLE qad_wkfl THEN */
      end. /* IF armstr3.ar_curr <> base_curr */

      max_apl = max_apl + vat_ndisc.

      run convert_to_pmt_curr (input-output max_apl).
      run convert_to_pmt_curr (input-output max_disc).

      arapplied = 0.
      /* IF CONTROL AMOUNT IS < THAN ZERO */
      if unapl_amt < 0
      then do:

        /* CONSIDER ONLY CREDIT INVOICES */
        if max_apl < 0
        then do:
           if unapl_amt <=  max_apl - max_disc
           then
              assign
                 arapplied  = max_apl - max_disc
                 discount   = max_disc.
           else if max_disc = 0
           then
              assign
                 arapplied  = unapl_amt
                 discount   = 0.

        end. /* IF max_apl < 0 */

      end. /* IF unapl_amt < 0 */
      else do:

         if unapl_amt <> 0
         and unapl_amt >= max_apl - max_disc
         then
            assign
               arapplied  = max_apl - max_disc
               discount   = max_disc.
         else if max_disc = 0
         then
            assign
               arapplied  = unapl_amt
               discount   = 0.
         else do:
            /* PARTIAL OR NO AMOUNT APPLIED, RECALC DISCOUNT   */
            /* IF PARTIAL PAYMENT, OTHERWISE SHOW ENTIRE DISC. */
            for first ct_mstr
               fields(ct_code ct_dating ct_disc_date ct_disc_days
                      ct_disc_pct ct_from_inv)
               where ct_code = armstr3.ar_cr_terms
               no-lock:
            end. /* FOR FIRST ct_mstr */
            if not available ct_mstr
            then
               assign
                  arapplied  = unapl_amt
                  discount   = 0.
            else if available ct_mstr
               and not ct_dating
            then do:
               arapplied  = unapl_amt.
               if unapl_amt = 0
               then
                  /* SHOW ENTIRE DISCOUNT AMOUNT */
                  discount   = max_disc.
               else do:
                  /* RECALC DISCOUNT FOR PARTIAL PAYMENT */
                  discount = ((unapl_amt / armstr3.ar_amt)  *
                              (armstr3.ar_amt - vat_ndisc)) *
                              (ct_disc_pct / 100).

                  /* ROUND PER PAYMENT CURRENCY ROUND METHOD */
                  {gprunp.i "mcpl" "p" "mc-curr-rnd"
                     "(input-output discount,
                       input rndmthd,
                       output mc-error-number)"}.
                  if mc-error-number <> 0
                  then do:
                     {pxmsg.i &MSGNUM=mc-error-number &ERRORLEVEL=2}.
                  end. /* IF mc-error-number <> 0 */
               end. /* ELSE DO */
            end. /* ELSE IF NOT ct_dating */
            else do:
               {ardiscb.i}
               arapplied = unapl_amt.
               if unapl_amt = 0
               then
                  /* SHOW ENTIRE DISCOUNT AMOUNT */
                  discount  = max_disc.
               else
                  /* RECALC DISCOUNT FOR PARTIAL PAYMENT */
                  discount  = arddisc.
            end. /* ELSE DO */
         end. /* ELSE DO */

      end. /* ELSE DO */

      /* SET REMAINING AMOUNTS, ALWAYS STORE MAX DISCOUNT EVEN IF */
      /* A PARTIAL PAYMENT (AND PARTIAL DISCOUNT) ARE CALCULATED  */
      /* MAX DISCOUNT IS USED IN THE TOGGLE ROUTINE               */
      assign
         balance = armstr3.ar_amt - armstr3.ar_applied
         maxdisc = max_disc.

      if armstr3.ar_curr <> base_curr
      or ar_mstr.ar_curr <> base_curr
      then do:
         run convert_to_pmt_curr (input-output balance).
         run convert_to_pmt_curr (input-output applied).
      end. /* IF armstr3.ar_curr <> base_curr */

      if sel_rec
      then do:

         if arapplied <> 0
         then
            sel_idr     = "*".
         else
            sel_idr     = " ".

         assign
            applied            = arapplied /* BALANCE - DISCOUNT */
            ar_mstr.ar_amt     = ar_mstr.ar_amt + arapplied
            ar_mstr.ar_applied = ar_mstr.ar_applied + arapplied
            unapl_amt          = unapl_amt - applied.

         /* CONVERT FROM FOREIGN TO BASE CURRENCY        */
         /* AND UPDATE THE BASE AMOUNT FIELD ar_base_amt */
         {gprunp.i "mcpl" "p" "mc-curr-conv"
            "(input ar_mstr.ar_curr,
              input base_curr,
              input ar_mstr.ar_ex_rate,
              input ar_mstr.ar_ex_rate2,
              input ar_mstr.ar_amt,
              input true, /* ROUND */
              output ar_mstr.ar_base_amt,
              output mc-error-number)"}.
         if mc-error-number <> 0
         then do:
            {pxmsg.i &MSGNUM=mc-error-number &ERRORLEVEL=2}.
         end. /* IF mc-error-number <> 0 */

         /* CONVERT FROM FOREIGN TO BASE CURRENCY            */
         /* AND UPDATE THE BASE AMOUNT FIELD ar_base_applied */
         {gprunp.i "mcpl" "p" "mc-curr-conv"
            "(input ar_mstr.ar_curr,
              input base_curr,
              input ar_mstr.ar_ex_rate,
              input ar_mstr.ar_ex_rate2,
              input ar_mstr.ar_applied,
              input true, /* ROUND */
              output ar_mstr.ar_base_applied,
              output mc-error-number)"}.
         if mc-error-number <> 0
         then do:
            {pxmsg.i &MSGNUM=mc-error-number &ERRORLEVEL=2}.
         end. /* IF mc-error-number <> 0 */
      end. /* IF sel_rec */
      else do:
         sel_idr            = " ".
         {&ARPAMTB-P-TAG5}
         assign
            ar_mstr.ar_amt     = 0
            ar_mstr.ar_applied = 0
            applied            = 0
            ar_mstr.ar_base_amt = 0
            ar_mstr.ar_base_applied = 0.
         {&ARPAMTB-P-TAG6}
      end. /* ELSE DO */
   end.  /* DO FOR armstr */

   if batchrun
   and unapl_amt = 0
   then
      leave workloop.
end.  /*WORKLOOP*/

/* IF A TEMP-TABLE RECORD WAS CREATED */
if ar_work
then do:
   hide frame im_sel no-pause.
   hide frame a no-pause.
   hide frame b no-pause.

   /* CHANGED THIRD PARAMETER jrnl FROM INPUT-OUTPUT TO INPUT */
   {gprun.i ""xxarpamte.p"" "(input ar_recno,
                            input artotal,
                            input jrnl,
                            output cpl_code)"}
/*GUI*/ if global-beam-me-up then undo, leave.

   {&ARPAMTB-P-TAG10}
end. /* IF ar_work */
else
   /*SET FLAG FOR MESSAGE IN CALLING PROGRAM*/
   no_open_doc = true.

/* TEST TO SEE IF ARDPAMTE.P COMPLETED SUCCESSFULLY*/
if not cpl_code
then
   {&ARPAMTB-P-TAG7}
   autocpl_code = false.
   {&ARPAMTB-P-TAG8}
else
   autocpl_code = true.

PROCEDURE convert_to_pmt_curr:
   define input-output parameter amt_to_convert like ar_amt.

   /* COMBINE EXCHANGE RATES BEFORE CONVERTING */
   {gprunp.i "mcpl" "p" "mc-combine-ex-rates"
      "(input inv_to_base_rate,
        input inv_to_base_rate2,
        input ar_mstr.ar_ex_rate2,
        input ar_mstr.ar_ex_rate,
        output comb_exch_rate,
        output comb_exch_rate2)"}

   /* CHANGED SIXTH INPUT PARAMETER FROM true TO false */
   {gprunp.i "mcpl" "p" "mc-curr-conv"
      "(input ar_mstr.ar_curr,
        input ar_mstr.ar_curr,
        input comb_exch_rate,
        input comb_exch_rate2,
        input amt_to_convert,
        input false,  /* ROUND */
        output amt_to_convert,
        output mc-error-number)"}

   if mc-error-number <> 0
   then do:
      {pxmsg.i &MSGNUM=mc-error-number &ERRORLEVEL=2}.
   end. /* IF mc-error-number */

END PROCEDURE.

/* DEFINED procedure is_euro_transparent */
{gpacctet.i}
